\ disasm.part2 of 4 v1.1 NAB
\ Included by disasm.

: .an+r+b
 .param .( .areg .,r)
 a2+ 10 +cycles is-mem ;

: .pc+r+b .param ." (pc" .,r) a2+ 10 +cycles is-mem ;

: .pc+w param .num ." (pc)" a2+ 8 +cycles is-mem ;

: .abs.w param .num 8 +cycles is-mem a2+ ;

: .abs.l dism-adr cell+ l@
 0 d.r a2+ a2+ 12 +cycles ;

: .ext ( op -- ) 7 and
select xt .abs.w xt .abs.l xt .pc+w
xt .pc+r+b xt .imm xt .dw
xt .dw xt .dw end-select execute ;

: .source op 3 3 op-bits select
xt .dreg xt .an xt .a@
xt .a@+ xt .-a@ xt .an+w
xt .an+r+b xt .ext
end-select execute ;

: ,source ., .source ;
: ,areg ., .areg ;
: ,dreg ., .dreg ;

: lsetb ( x -- x' mask|0 ) \ least set b
  dup dup 1- \ assume 2s compl
  and swap over xor
;

: bit# ( single-bit-mask -- n )
  0
  over (hex) ff00 and 0<> 8 and or
  over (hex) f0f0 and 0<> 4 and or
  over (hex) cccc and 0<> 2 and or
  swap (hex) aaaa and 0<> 1 and or
;

: .reglist ( param offset -- )
  >r begin dup while \ p
      lsetb over >r bit# \ p#
      8 /mod 255 over if \ prqm
          invert then \ prqm'
      r> and 0= if \ prq
          r@ swap - 1 and 1+
      else drop 0 then \ prq'
      r@ rot - abs [char] 0 + emit
      ?dup if \ p q'
          s" .DA" drop + c@ emit
      then \ p
  repeat drop r> drop
;

\ .movem unsimplified [JCF]
: .movem
  param 3 3 op-bits 4 =
  if 7 else  0
  then  .reglist a2+
;

: nib4:0 6&7?
  if  ." move" .word ." sr," 6 +cycles
  else  ." negx" .size 4 2 +if-long
  then  .source ;

: dism-clr
  ." clr" .size .source 4 2 +if-long ;

: nib4:4 6&7?
  if  ." move" .word .source ." ,ccr"
  ( wrong?)
  12 +cycles
  else  ." neg" .size 4 2 +if-long .source
  then ;

: nib4:6 6&7?
  if  ." move" .word .source ." ,sr"
  12 +cycles
  else  ." not" .long .source
   6 +cycles 2 +mem  then ;

: nib4:8 6&7
  case
  0 of ." nbcd" .byte .source
    6 +cycles 2 +mem  endof
  1 of ." pea" >arg .source
    4 +cycles  endof
  ." movem" 6? 1|2 size$
  .movem ., .source 12 +cycles
  endcase ;

: nib4:10 6&7?
   if  ." tas" .byte 6 +mem
  else  ." tst" 6&7 size$
  then  .source 4 +cycles ;

: nib4:14 7?
  if  6? 2 to dism-size
  if  ." jmp" doing-call done?
    approximate
  else  ." jsr" doing-call 8 +cycles
  then  >arg .source
  else 0 4 op-bits ." trap" >arg .#
  dup .num
 15 = if true to palmostrap then
  then ;

: nib4:12
  ." movem" 6? 1|2 size$
 8 +cycles
  dism-adr >r a2+ .source
  r> dism-adr >r to dism-adr ., .movem
  r> to dism-adr ;

: nib4-unique
  op>>9 6? if  ." lea" >arg .source ,areg
    approximate
  else  ." chk.w" >arg op (hex) 3f and
    (hex) 3c =
    if  1 to dism-size \ word-size
   then
    .source ,dreg 8 +cycles
  then ;

: nib4-special
  op (hex) 100 and
  if  nib4-unique
  else ( jmp ) 9 3 op-bits select
    xt nib4:0 xt dism-clr xt nib4:4
    xt nib4:6 xt nib4:8 xt nib4:10
    xt nib4:12 xt nib4:14
  end-select execute then ;

: .nib4-reg
  op dup (hex) fff8 and case
   (hex) 4e68 of ." move" >arg
     ." usp," .areg 6 +cycles 2 +mem
   endof
   (hex) 4e60 of ." move" >arg .areg
     ." ,usp" 4 +cycles endof
   (hex) 4e58 of ." unlk" >arg .areg
     12 +cycles endof
   (hex) 4880 of ." ext" .word .dreg
     4 +cycles endof
   (hex) 4e50 of ." link" >arg .areg .,
     1 to dism-size .imm 18 +cycles
   endof
   (hex) 4840 of ." swap" >arg .dreg
     4 +cycles endof
   (hex) 48c0 of ." ext" .long .dreg
     4 +cycles endof
   drop nib4-special
  endcase ;

: nib4
  op case
   (hex) 4e76 of ." trapv" 4 +cycles
   endof
   (hex) 4e75 of ." rts" done?
   16 +cycles endof
   (hex) 4e73 of ." rte" done?
   20 +cycles endof
   (hex) 4e70 of ." reset"
   123 +cycles endof
   (hex) 4e71 of ." nop" 4 +cycles endof
   (hex) 4e77 of ." rtr" done?
   20 +cycles endof
   (hex) 4afa of ." illegal"
   34 +cycles endof
   (hex) 4afb of ." illegal"
   34 +cycles endof
   (hex) 4afc of ." illegal"
   34 +cycles endof
   .nib4-reg
 endcase ;
